home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / sqlMode.tcl < prev    next >
Encoding:
Text File  |  1997-10-08  |  4.8 KB  |  131 lines  |  [TEXT/ALFA]
  1.  
  2. #############################################################################
  3. #   FILE: sql.tcl
  4. #----------------------------------------------------------------------------
  5. # AUTHOR:     Joel D. Elkins
  6. #     of      New Media, Inc.
  7. #             200 South Meridian, Ste. 220
  8. #             Indianapolis, IN 46225
  9. #
  10. # internet:   jdelkins@iquest.net  (preferred)
  11. # compuserve: 72531,314
  12. # AOL:        jdelkins
  13. #
  14. #   Copyright © 1994-1995 by Joel D. Elkins
  15. #   All rights reserved.
  16. #############################################################################
  17. #
  18. #  Alpha mode for SQL and Oracle's PL/SQL programming language
  19. #  Converts SQL and PL/SQL keywords to uppercase on the fly and colorizes
  20. #
  21. #############################################################################
  22. # HISTORY
  23. #                  
  24. # modified who rev reason
  25. # -------- --- --- ------ 
  26. # 7/29/94  JDE 1.0 Original 
  27. # 2/8/95   JDE 1.1 Added electUpper for tab, cr, and ';'
  28. #############################################################################
  29.  
  30. alpha::mode SQL 1.0 dummySQL { *.sql *.SQL *.pkg} 
  31.  
  32. proc dummySQL {} {}
  33.  
  34. #############################################################################
  35. # PL/SQL mode by Joel D. Elkins
  36. #############################################################################
  37. newPref f    elecRBrace            {0}    SQL
  38. newPref f    electricSemi        {1}    SQL
  39. newPref    v    wordBreak            {(\$)?\w+}    SQL
  40. newPref    v    prefixString        {--}    SQL
  41. newPref    f    elecLBrace            {0}    SQL
  42. newPref    f    wordWrap            {0}    SQL
  43. newPref    v    funcExpr            {(PROCEDURE|FUNCTION)[ \t]+(\w+)}    SQL
  44. newPref    v    wordBreakPreface    {[^a-zA-Z0-9_\$]} SQL
  45.  
  46. bind '\ ' {electUpper "\ "} "SQL"
  47. bind '\t' {electUpper "\t"} "SQL"
  48. bind '\r' {electUpper "\r"} "SQL"
  49. bind '\;' {electUpper "\;"} "SQL"
  50.  
  51.  
  52. set sqlKeywords {
  53.     ABORT ACCEPT ACCESS ALTER AND ARRAY ARRAYLEN AS ASSERT AT AVG BEGIN BETWEEN BODY
  54.     CASE COLUMNS COMMIT CONSTANT COUNT CREATE CURSOR DECLARE DEFAULT DEFINITION
  55.     DELETE DESC DISPOSE DISTINCT DO DROP ELSE ELSIF END ENTRY EXCEPTION EXISTS EXIT
  56.     FALSE FETCH FOR FROM FUNCTION GOTO IF IN INSERT INTERSECT INTO IS LIKE LOOP MAX MIN
  57.     MINUS MOD NEW OF ON OPEN OR OUT PACKAGE PARTITION POSITIVE PRAGMA PRIVATE
  58.     PROCEDURE PUBLIC RANGE RECORD REM REPLACE RETURN ROLLBACK ROWTYPE RUN SAVEPOINT
  59.     SELECT SET SIZE START STDDEV SUM THEN TO TYPE UNION UNIQUE UPDATE USE VALUES
  60.     VARIANCE WHEN WHERE WHILE WITH XOR
  61. }
  62. ###    Just colorize uppercase keywords
  63. #    abort accept access alter and array arraylen as assert at avg begin between body
  64. #    case columns commit constant count create cursor declare default definition
  65. #    delete desc dispose distinct do drop else elsif end entry exception exists exit
  66. #    false fetch for from function goto if in insert intersect into is like loop max min
  67. #    minus mod new of on open or out package partition positive pragma private
  68. #    procedure public range record rem replace return rollback rowtype run savepoint
  69. #    select set size start stddev sum then to type union unique update use values
  70. #    variance when where while with xor
  71. ###
  72. regModeKeywords -e {--} -b {/*} {*/} -c red -k blue SQL $sqlKeywords
  73. unset sqlKeywords
  74. #================================================================================
  75.  
  76. catch {unset plSqlKeywords}
  77.  
  78. lappend plSqlKeywords \
  79.     abort accept access alter and array arraylen as assert at avg begin between body \
  80.     case columns commit constant count create cursor declare default definition \
  81.     delete desc dispose distinct do drop else elsif end entry exception exists exit \
  82.     false fetch for from function goto if in insert intersect into is like loop max min \
  83.     minus mod new of on open or out package partition positive pragma private \
  84.     procedure public range record rem replace return rollback rowtype run savepoint \
  85.     select set size start stddev sum then to type union unique update use values \
  86.     variance when where while with xor
  87.  
  88.  
  89. proc electUpper {char} {
  90.     global plSqlKeywords
  91.     
  92.     set a [getPos]
  93.     backwardWord
  94.     set b [getPos]
  95.     
  96.     #make sure we're not in a comment
  97.     beginningOfLine
  98.     set commentSearch {(^[ \t]*rem[ \t]+)|(^[ \t]*REM[ \t]+)|--}
  99.     if {[catch {search -s -r 1 -f 1 -l $b -- $commentSearch [getPos]}] != 0} {
  100.         #if not, make the word uppercase if it's a keyword
  101.         set cmd [getText $b $a]
  102.         goto $b
  103.         if {[lsearch -exact $plSqlKeywords [string tolower $cmd]] >= 0} {
  104.             upcaseWord
  105.         }
  106.     }
  107.     goto $a
  108.     if { 0 == [string compare $char "\r"] } {
  109.         bind::CarriageReturn
  110.     } else {
  111.         insertText $char
  112.     }
  113. }
  114.  
  115. proc SQL::MarkFile {} {
  116.     global SQLmodeVars
  117.     set pos 0
  118.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 $SQLmodeVars(funcExpr) $pos} res]} {
  119.         set start [lindex $res 0]
  120.         set end [lindex $res 1]
  121.         set text [lindex [getText $start $end] 1]
  122.         set pos $end
  123.         set inds($text) "$start $end"
  124.     }
  125.     
  126.     if {[info exists inds]} {
  127.         foreach f [lsort [array names inds]] {
  128.             setNamedMark $f [lineStart [lineStart [lindex $inds($f) 0]] - 1] [lindex $inds($f) 0] [lindex $inds($f) 1]
  129.         }
  130.     }
  131. }